home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / tqbe3 / utqbe.pas < prev   
Pascal/Delphi Source File  |  1995-12-22  |  7KB  |  237 lines
  1. Unit UTqbe; { Small dataset derived class }
  2.  
  3. {  NEW !!! AnswerType property allows to PARADOX,DBASE and ASCII answer table types }
  4. {  NEW !!! Query params can be defined (see demo.pas) }
  5.  
  6. interface
  7.  
  8. Uses Classes,DBTables,DB,SysUtils,DBConsts,LibConst,dbiProcs,dbiTypes,
  9.      DsgnIntf;
  10.  
  11. { WARNING: READ CAREFULLY AND GOOD LUCK USING TQBE }
  12. (*
  13.   Answer table name can be specified with or without alias.
  14.   Eg: :dbdemos:void.db
  15.  
  16.   Assumed answer table Driver: PARADOX
  17.   The new property: AnswerType allows to PARADOX,DBASE and ASCII answer table types
  18.  
  19.   If the answer table exists, an atempt to delete it is made before copying
  20.   the result cursor.
  21.   The phisical answer table must be opened in exclusive mode and all related
  22.   family files are erased together with the table.
  23.  
  24.   Other functions in this unit:
  25.  
  26. **  Function GetAliasPath(Const Alias:String):String;
  27.       Returns the path for the "alias" or a empty string if not found.
  28.       Eg: ('dbdemos') returns 'c:\delphi\demos\data'
  29.  
  30. **  Function GetDBTablePath(Const TableName:String):String;
  31.       Returns the TableName with path instead of alias (if it has an alias).
  32.       Eg: (':dbdemos:customer.db') returns 'c:\delphi\demos\data\customer.db'
  33.  
  34. *)
  35.  
  36. Const MaxParam   = 5;  { max number of query parameters }
  37.       MaxParamLen=30; { max length of a substituted param }
  38.  
  39. Type
  40.      TQBE=Class(TDBDataSet)
  41.      private
  42.        FAnswerTable:String;
  43.        FAnswerType:TTableType;
  44.        FBlankasZero,
  45.        FAuxTables,
  46.        FRequestLive:Boolean;
  47.      protected
  48.        function CreateHandle: HDBICur; override;
  49.      public
  50.        FQBE: TStrings;
  51.        NumParam:Integer;
  52.        Param,Subst:Array[0..MaxParam] of String[MaxParamLen];
  53.        procedure SetQBE(QBE: TStrings);
  54.        Constructor Create(AOwner:TComponent); override;
  55.        destructor Destroy; override;
  56.        Procedure AddParam(Const tmpParam,tmpSubst:String);
  57.        Function ReplaceString(s:String):String;
  58.        Procedure ClearParams;
  59.      published
  60.        property QBE: TStrings read FQBE write SetQBE;
  61.        property AnswerTable: String read FAnswerTable write FAnswerTable;
  62.        property RequestLive: Boolean read FRequestLive write FRequestLive;
  63.        property BlankasZero: Boolean read FBlankasZero write FBlankAsZero;
  64.        property AuxTables: Boolean read FAuxTables write FAuxTables;
  65.        property AnswerType:TTableType read FAnswerType write FAnswerType;
  66.      End;
  67.  
  68. Function GetAliasPath(Const Alias:String):String;
  69. Function GetDBTablePath(Const TableName:String):String;
  70. Procedure Register;
  71.  
  72. implementation
  73.  
  74. Uses Dialogs,dbiErrs,Forms;
  75.  
  76. Constructor TQBE.Create(AOwner:TComponent);
  77. Begin
  78.   inherited Create(AOwner);
  79.   FQBE := TStringList.Create;
  80.   NumParam:=0;
  81.   FAnswerType:=ttParadox; { by default, Paradox answer tables }
  82. end;
  83.  
  84. destructor TQBE.Destroy;
  85. Begin
  86.   FQBE.Free;
  87.   inherited Destroy;
  88. End;
  89.  
  90. Procedure TQBE.ClearParams;
  91. Begin
  92.   NumParam:=0; { reset params to zero (no params) }
  93. End;
  94.  
  95. Procedure TQBE.AddParam(Const tmpParam,tmpSubst:String);
  96. Begin
  97.   if tmpParam<>'' then
  98.   Begin
  99.     if NumParam<MaxParam then
  100.     Begin
  101.       Inc(NumParam);
  102.       Param[NumParam]:=tmpParam;
  103.       Subst[NumParam]:=tmpSubst;
  104.     End
  105.     Else Raise Exception.Create('Max number of query parameters achieved');
  106.   End;
  107. End;
  108.  
  109. Function TQBE.ReplaceString(s:String):String;
  110. Var t,i:Integer;
  111. Begin
  112.   for t:=1 to NumParam do
  113.   Repeat
  114.     i:=Pos(Param[t],s);
  115.     if i>0 then s:=Copy(s,1,i-1)+Subst[t]+Copy(s,i+Length(Param[t]),255);
  116.   Until i=0;
  117.   result:=s;
  118. End;
  119.  
  120. function TQBE.CreateHandle: HDBICur;
  121. Var p:HDbiCur;
  122.     Stmt:hDBIStmt;
  123.     St:Array[0..255] of Char;
  124.     aBatTblDesc:BATTblDesc;
  125.     r:Longint;
  126.     dbiErr:DBIRESULT;
  127.     NewQBE:TStrings;
  128.     t:Integer;
  129.     tmpType:String;
  130. Begin
  131.   NewQBE:=TStringList.Create;
  132.   With FQBE do
  133.   for t:=0 to Count-1 do NewQBE.Add(ReplaceString(Strings[t]));
  134.   Check(dbiQPrepare(DBHandle,qryLangQBE,NewQBE.GetText,Stmt));
  135.   if FRequestLive then Check(dbiSetProp(hDBIObj(Stmt),stmtLIVENESS,Longint(wantLive)))
  136.                   Else Check(dbiSetProp(hDBIObj(Stmt),stmtLIVENESS,Longint(wantDefault)));
  137.   if FBlankAsZero then Check(dbiSetProp(hDBIObj(Stmt),stmtBLANKS,1));
  138.   if FAuxTables then Check(dbiSetProp(hDBIObj(Stmt),stmtAUXTBLS,1));
  139.   Check(dbiQExec(Stmt,@p));
  140.   Check(dbiQFree(Stmt));
  141.   if (FAnswerTable<>'') And Assigned(p) then
  142.   Begin
  143.     Check(DbiSetToBegin(p));
  144.     With aBatTblDesc do
  145.     Begin
  146.       hDB:=DBHandle;
  147.       StrPCopy(szTblName,GetDBTablePath(FAnswerTable));
  148.       Case FAnswerType of
  149.         ttParadox: tmpType:=szParadox;
  150.         ttDbase  : tmpType:=szDbase;
  151.         ttAscii  : tmpType:=szAscii;
  152.       end;
  153.       StrPCopy(szTblType,tmpType);
  154.       szUsername[0]:=#0;
  155.       szPassword[0]:=#0;
  156.     End;
  157.     r:=0;
  158.     dbiErr:=dbiDeleteTable(DBHandle,aBatTblDesc.szTblName,aBatTblDesc.szTblType);
  159.     if dbiErr<>DBIERR_NOSUCHTABLE then Check(dbiErr);
  160.     Check(DbiBatchMove(nil,p,@aBatTblDesc,nil,batchCOPY,0,
  161.                             nil, nil, nil, 0, nil, nil,
  162.                             nil, nil, nil, nil, TRUE, TRUE,
  163.                             r, TRUE));
  164.   End;
  165.   NewQBE.Free;
  166.   Result:=p;
  167. End;
  168.  
  169. procedure TQBE.SetQBE(QBE: TStrings);
  170. begin
  171.   FQBE.Assign(QBE);
  172. end;
  173.  
  174. Function HasAlias(Const TableName:String):Boolean;
  175. Begin
  176.   Result:=Pos(':',TableName)>0;
  177. End;
  178.  
  179. Function GetAliasPath(Const Alias:String):String;
  180. Var AliasList:TStringList;
  181.     i:Longint;
  182.     DBPath:String;
  183. Begin
  184.   Result:='';
  185.   AliasList:=TStringList.Create;
  186.   try
  187.     Session.GetAliasNames(AliasList);
  188.     i:=AliasList.IndexOf(Alias);
  189.     if i<0 then raise EDatabaseError.Create('Alias '+Alias+' doesnt exist')
  190.     else
  191.     Begin
  192.       Session.GetAliasParams(Alias,AliasList);
  193.       DBPath := AliasList.Values['PATH'];
  194.       if DBPath='' then raise EDatabaseError.Create('Alias path from '+Alias+' invalid')
  195.                    else Result:=DBPath;
  196.     end;
  197.   finally
  198.     AliasList.Free;
  199.   end;
  200. End;
  201.  
  202. Procedure SplitTableName(Const TableName:String; Var Alias,Name:String);
  203. Var p1,p2:Integer;
  204. Begin
  205.   Name:=TableName;
  206.   Alias:='';
  207.   p1:=Pos(':',TableName);
  208.   if p1>0 then
  209.   Begin
  210.     p2:=Pos(':',Copy(TableName,p1+1,255));
  211.     if p2>0 then
  212.     Begin
  213.       Alias:=Copy(TableName,p1+1,p2-1);
  214.       Name:=Copy(TableName,p1+p2+1,255);
  215.     End;
  216.   End;
  217. End;
  218.  
  219. Function GetDBTablePath(Const TableName:String):String;
  220. Var Alias,Name:String;
  221. Begin
  222.   if not HasAlias(TableName) then Result:=TableName
  223.   else
  224.   Begin
  225.     SplitTableName(TableName,Alias,Name);
  226.     if Alias<>'' then Result:=GetAliasPath(Alias)+'\'+Name
  227.                  else Result:=TableName;
  228.   End;
  229. End;
  230.  
  231. Procedure Register;
  232. Begin
  233.   RegisterComponents(LoadStr(srDAccess),[TQbe]);
  234. End;
  235.  
  236. end.
  237.